COMMENT ⊗   VALID 00004 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	
C00004 00003	
C00009 00004	SUBR COMND
C00013 ENDMK
C⊗;

BEGIN "SYN4D"
	REQUIRE "GEOMES.HDR[GEM,HE]" SOURCE_FILE;
	DEFINE α="COMMENT";
	DEFINE π="3.1415927";
	DEFINE SUBR="SIMPLE PROCEDURE";
	DEFINE ISUBR="SIMPLE INTEGER PROCEDURE";
	DEFINE THRU="STEP 1 UNTIL";
	DEFINE ⊂="BEGIN";
	DEFINE ⊃="END";

	EXTERNAL SIMPLE REAL PROCEDURE ACOS(REAL W);

	INTEGER FRATE,CHR,GRAV,TAKE,IP,X,Y,Z;
	REAL NR,NT;STRING STR;

SUBR INIT;	α INITIALIZATION;
BEGIN "INIT"
	MKUNIV;GEODPY;
	X ← 0;Y ← 3;Z ← 6;
	IP ← 0;TAKE ← 1;
	FRATE ← 20;
	OUTSTR("   FRATE =");STR ← INCHWL;
	IF LENGTH(STR)≠0 THEN FRATE ← INTSCAN(STR,CHR);
	NT ← 1.0/FRATE;NR ← NT*π;GRAV ← 32*NT;
END "INIT";


SIMPLE REAL PROCEDURE ANGL(INTEGER B1,A1,B2,A2);
BEGIN "ANGL"
	REAL ANG;
	B1 ← A1+LOCOR(B1);
	B2 ← A2+LOCOR(B2);
	ANG ← ACOS(IX(B1)*IX(B2)+IX(B1+1)*
	IX(B2+1)+IX(B1+2)*IX(B2+2));
	RETURN(ANG);
END "ANGL";

ISUBR BUMP(INTEGER B1,B2,AX1,AX2;REAL MINA,MAXA,SP);
BEGIN "BUMP"
	INTEGER STP;
	REAL ANG;
	IF B1<0 THEN B1 ← -B1;
	ANG ← SP+ANGL(B1,AX1,B2,AX2);
	IF ANG<MINA∨ANG>MAXA THEN STP ← -1
	ELSE STP ← 0;
	RETURN(STP);
END "BUMP";

ISUBR BEND(INTEGER BAC,BD1,BD2,AR1,AR2,AR3;REAL MN,MX,SP);
BEGIN "BEND"
	INTEGER PAST;
	REAL RO,RX,RY,RZ;
	SP ← NR*SP;RO ← SP;
	IF BAC=2 THEN SP ← -SP;
	IF BUMP(BD1,BD2,AR2,AR3,MN,MX,SP) THEN BEGIN
	  PAST ← -1;
	  IF BAC THEN BEGIN
	    IF BAC>0 THEN RETURN(PAST);
	    RO ← -RO;
	    END;
	  END
	ELSE PAST ← 0;
	RX ← RY ← RZ ← 0;
	CASE AR1 OF ⊂ [0] RX ← RO;[3] RY ← RO;[6] RZ ← RO ⊃;
	ROTATE(BD1,RX,RY,RZ);
	RETURN(PAST);
END "BEND";

SIMPLE REAL PROCEDURE ANGLE(INTEGER B1,A1,N1);
BEGIN "ANGLE"
	INTEGER O1;
	REAL DIS,AN;
	O1 ← LOCOR(B1);DIS ← DISTAN(N1,O1);O1 ← O1+A1;
	AN ← ACOS(IX(O1)*((XWC(B1)-XWC(N1))/DIS)+IX(O1+1)*
	((YWC(B1)-YWC(N1))/DIS)+IX(O1+2)*((ZWC(B1)-ZWC(N1))/DIS));
	RETURN(AN);
END "ANGLE";

SIMPLE REAL PROCEDURE RBDEL(INTEGER B1,A1,B2,A2;REAL DV);
BEGIN "RBDEL"
	REAL RB;
	RB ← ANGL(B1,A1,B2,A2)/DV;
	RETURN(RB);
END "RBDEL";

SIMPLE REAL PROCEDURE RODEL(INTEGER B1,A1,N1;REAL DV);
BEGIN "RODEL"
	REAL ROD;
	ROD ← ANGLE(B1,A1,N1)/DV;
	RETURN(ROD);
END "RODEL";

SIMPLE REAL PROCEDURE TDEL(INTEGER B1,N1;REAL DV);
BEGIN "TDEL"
	REAL TD;
	TD ← DISTAN(N1,LOCOR(B1))/DV;
	RETURN(TD);
END "TDEL";

SUBR PLOP;
BEGIN "PLOP"
   α IF CA THEN CAMR()????;
	IF TAKE>0 THEN ⊂ IF TAKE>1 THEN SHOW2(0,1)
		       ELSE GEODPY;RETURN;⊃;
	IF TAKE<-1 THEN SHOW2(0,1) ELSE GEODPY;
	IP ← IP+1;
	OUTSTR(" FRAME "&CVS(IP));PLOTO("FRM."&CVS(IP));
END "PLOP";
SUBR COMND;
BEGIN "COMND"
	INTEGER PIC,GIRL,HD,RA,LA,RS,LS,RH,LH;
	INTEGER RT,LT,RL,LL,RF,LF;
	INTEGER YES,NO,TWO,LC;
	REAL DG4,DG5,DG7,DG11,FAST,SLOW,FASTER;

α INIT THEN DO UNTIL?;

SUBR GAPO;
BEGIN "GAPO"
	TRANSL(GIRL,0,0,.3);PLOP;
END "GAPO";

 SUBR NOD(INTEGER B1,UPDOW;REFERENCE REAL SP);
 BEGIN "NOD"
	INTEGER A1,A2,A3,HD;
	REAL MI,MA;
	HD ← CCW(CCW(CCW(CCW(B1))));
	IF UPDOW THEN ⊂ A1 ← X;A2 ← Z;A3 ← Y;
	  MI ← DG7;MA ← DG11;⊃
	ELSE ⊂ A1 ← Y;A2 ← X;A3 ← Z;MI ← DG4;MA ← DG5;⊃;
	IF BEND(YES,-HD,B1,A1,A2,A3,MI,MA,SP) THEN SP ← -SP;
 END "NOD";

ISUBR SALUTE(INTEGER B1;REAL SP);
BEGIN "SALUTE"
	INTEGER I,RS,RA;
	REAL MI,MX,MB;
	RA ← CW(CW(CW(B1)));RS ← CW(RA);
	MB ← π/1.7;MX ← π/2;I ← 3;SP ← -SP;TWO ← 2;
	MI ← 0;
	I ← I+BEND(TWO,-RA,RS,X,Y,Y,MI,MB,SP);
	I ← I+BEND(TWO,-RS,B1,Z,Y,Y,MI,MX,SP);
	I ← I+BEND(TWO,-RS,B1,X,Z,Z,MI,MX,SP);
	RETURN(I);
END "SALUTE";

SUBR WALK(INTEGER B1,N1;REAL SP);
BEGIN "WALK"
	INTEGER DUR;
	REAL FSP;
	DUR ← TDEL(B1,N1,SP);
	FSP ← TDEL(B1,N1,DUR);
END "WALK";

SUBR SCENE;
BEGIN "SCENE"
	INTEGER IT;
	REAL SP;
	SP ← FASTER;
	FOR IT←1 THRU 10 DO
	⊂ NOD(GIRL,NO,FAST);GAPO;⊃;
WHILE TRUE DO
	⊂ IF SALUTE(GIRL,SP)=0 THEN ⊂ IF SP<0 THEN RETURN;SP ← -SP;⊃
	  ELSE GAPO;⊃;
END "SCENE";

	PIC←INB3D("LYN[CMS,LCS]");
	GIRL←FDNAME("GIRL");
	HD←FDNAME("HD");
	RA←FDNAME("RA");
	LA←FDNAME("LA");
	RL←FDNAME("RL");
	LL←FDNAME("LL");
	RF←FDNAME("RF");
	LF←FDNAME("LF");
	RS←FDNAME("RS");
	LS←FDNAME("LS");
	RT←FDNAME("RT");
	LT←FDNAME("LT");
	RH←FDNAME("RH");
	LH←FDNAME("LH");
	GEODPY;

	NO ← 0;YES ← -1;FAST ← .8;SLOW ← .5;
	FASTER ← .8;

	DG4 ← π/4;DG5 ← DG4*3;
	DG7 ← π/2.5;DG11 ← π/1.8;

WHILE TRUE DO
 BEGIN
	LC ← INCHRW;
	IF LC="P" THEN ⊂ TAKE ← -2;PLOP;⊃;
	IF LC="S" THEN SCENE;
	IF LC="G" THEN GEOMED;
 END;
END "COMND";



        α MAIN EXECUTION;
	OUTSTR(12&12&12&12&12);
	INIT;
	COMND;

END "SYN4D";